0010 REM "XFRTBD -- Thoruoghbred to PVX communications transfer program"
0020 REM "Thoroughbred is a trade mark of Throughbred Corp."
0030 REM "(c) Copyright 1988-1992, Sybex Ltd (Ontario, Canada)"
0040 REM ""
0050 BEGIN 
0060 GOSUB 0430
0070 LET O$="L"; GOSUB 0470; GOSUB 0520; LET V$=X1$
0080 IF V$="" THEN GOTO 0150
0090 LET O$="M"; GOSUB 0470; GOSUB 0520; LET V2$=X1$
0100 LET O$="F"; GOSUB 0470; GOSUB 0520; LET V1$=X1$
0110 OPEN (3,ERR=0130)V$
0120 EXTRACT (3,KEY=V1$,DOM=0150); GOTO 0150
0130 LET V1$="ERROR="+STR(ERR); LET O$="!"; GOSUB 0470; LET O$=V1$; GOSUB 0470
0140 GOTO 0400
0150 IF V$<>"" THEN GOTO 0180
0160 LET O$="F"; GOSUB 0470; GOSUB 0520; LET P$=X1$
0170 IF P$="" THEN GOTO 0400 ELSE GOTO 0210
0180 LET P$=KEY(3,END=0400); READ (3)
0190 IF LEN(P$)>8 THEN LET P$=P$(1,POS(" "=P$(1,8)+" ")-1); REM "** May need to be adjusted **"
0200 IF P$>V2$ THEN GOTO 0400
0210 REM "500 - TRANSMIT FILE"
0220 WAIT 1
0230 OPEN (2,ERR=0380)P$
0240 LET O1$=""
0250 LET F$=FID(2)
0260 LET K=DEC(F$(11,1)),R=DEC(F$(15,2)),N=DEC(F$(12,3))
0270 IF K=0 THEN GOTO 0290
0280 IF N>32167 THEN LET K=K-6 ELSE LET K=K-4
0290 IF AND($0F$,F$(10,1))=$04$ THEN LET R=0,K=0,N=0
0300 IF F$(10,1)=$01$ THEN LET K1$="SE" ELSE LET K1$=STR(K:"00")
0310 LET K$=P$+"        ",O$=K$(1,8)+STR(R:"0000")+K1$+STR(N:"000000")
0320 GOSUB 0470
0330 LET F1$=HTA(F$(10,1)); IF F1$(2,1)="4" THEN GOSUB 0700 ELSE GOSUB 0890
0340 IF O1$="" THEN LET O$="*"; GOSUB 0470
0350 GOSUB 0520
0360 CLOSE (2)
0370 GOTO 0150
0380 REM "800 - ERROR OPENING FILE"
0390 GOSUB 0680; GOTO 0340
0400 REM "900 - END OF SESSION"
0410 GOSUB 0640
0420 STOP 
0430 REM "1000- PREPARE COM"
0440 DIM B$(4000)
0450 LET B1=1,B$(1,4)="0001",B=11
0460 RETURN 
0470 REM "1100 - WRITE RECORD"
0480 LET U=LEN(O$)+4
0490 IF U+B>2000 THEN GOSUB 0520
0500 LET B$(B,U)=STR(U-4:"0000")+O$,B=B+U
0510 RETURN 
0520 REM "1200 - FLUSH BLOCK"
0530 LET B$(5,4)=STR(B-1:"0000"),B$(9,2)=HTA(LRC(B$(11,B-11)))
0540 LET B2=1
0550 IF B-B2<75 THEN GOTO 0580
0560 PRINT "{",B$(B2,75),"}+"
0570 LET B2=B2+75; GOTO 0550
0580 PRINT "{",B$(B2,B-B2),"}?"
0590 INPUT (0,TIM=50,ERR=0540)'CI',X$
0600 IF LEN(X$)>1 THEN LET X1$=X$(2),X$=X$(1,1) ELSE LET X1$=""
0610 IF X$<>"Y" THEN WAIT 2; GOTO 0540
0620 IF B1=9999 THEN LET B1=0 ELSE LET B1=B1+1
0630 LET B$(1,5)=STR(B1:"0000"),B=11; RETURN 
0640 REM "1300 - CLOSE/FLUSH COMM"
0650 IF B<>11 THEN GOSUB 0520
0660 GOSUB 0520
0670 RETURN 
0680 REM "1900 - SEND ERROR MESSAGES"
0690 LET O1$="ERROR #"+STR(ERR); LET O$="!"; GOSUB 0470; LET O$=O1$; GOTO 0470
0700 REM "2000 - DEBLOCK PROGRAMS"
0710 CLOSE (2); OPEN (2,ISZ=256)P$
0720 READ RECORD (2)R$
0730 LET O=13+DEC($00$+R$(12,1))*3
0740 IF LEN(R$(O))<1 THEN GOSUB 0850
0750 LET L=DEC($00$+R$(O,1)); IF L<>0 THEN LET O=O+1,L=L-1; GOTO 0780
0760 IF LEN(R$(O))<3 THEN GOSUB 0850
0770 LET L=DEC(R$(O,3))-3,O=O+3
0780 IF LEN(R$(O))<L THEN GOSUB 0850; GOTO 0780
0790 SETERR 0680
0800 LET O$=LST(R$(O,L))
0810 SETERR 0000
0820 IF O$(1,4)=" END" THEN RETURN 
0830 GOSUB 0470
0840 LET O=O+L; GOTO 0740
0850 REM "2500 - READ NEXT"
0860 READ RECORD (2,ERR=0880)R1$
0870 LET R$=R$(O)+R1$; LET O=1; RETURN 
0880 EXITTO 0680; REM "POP STACK AND RETURN ERROR"
0890 REM "3000 - EXTRACT DATA FILE"
0900 DIM Z$(R,$00$)
0910 IF K<>0 THEN LET K$=KEY(2,END=1000,ERR=0680); GOTO 0925
0920 LET K$=STR(IND(2,ERR=1000):"000000"); GOTO 0930
0930 READ RECORD (2,ERR=1000)R$
0940 GOTO 0950
0950 LET L=POS(Z$=R$+Z$)-1
0960 IF L<0 THEN LET L=0
0970 LET O$=K$+$8A$+R$(1,L)
0980 GOSUB 1010
0990 GOTO 0910
1000 RETURN 
1010 REM "3500 - CONVERT DATA"
1020 LET O=1
1030 LET O1=POS("z"<O$(O)); IF O1=0 THEN GOTO 1080
1040 LET O=O+O1-1
1050 IF O$(O,1)=$8A$ THEN LET O$(O,1)="|",O=O+1; GOTO 1030
1060 LET O$=O$(1,O-1)+"~"+HTA(O$(O,1))+O$(O+1),O=O+3
1070 GOTO 1030
1080 LET O=1
1090 LET O1=POS(" ">O$(O)); IF O1=0 THEN GOTO 0470
1100 LET O=O+O1-1
1110 IF O$(O,1)=$8A$ THEN LET O$(O,1)="|",O=O+1; GOTO 1090
1120 LET O$=O$(1,O-1)+"~"+HTA(O$(O,1))+O$(O+1),O=O+3
1130 GOTO 1090
